home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / bioryth.arc / BIO.BAS (.txt)
Encoding:
GW-BASIC  |  1985-08-21  |  4.4 KB  |  151 lines
  1. 10  '*************************************************
  2. 20  '              BIORHYTHMS
  3. 30  '*************************************************
  4. 40  '
  5. 50  KEY OFF: SCREEN 0: WIDTH 80
  6. 60  '
  7. 70  DIM MON%(12),MONTH$(12)
  8. 80  '
  9. 90  DIGITS$ = "1234567890"
  10. 100  CL$="1-2-3-4-5-6-7-8-9-0-":PI=3.1416
  11. 110  RESTORE 130
  12. 120  FOR I%=1 TO 12:READ MON%(I%):NEXT I%
  13. 130  DATA 31,28,31,30,31,30,31,31,30,31,30,31
  14. 140  '
  15. 150  FOR I%=1 TO 12:READ MONTH$(I%): NEXT I%
  16. 160  DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC
  17. 170  '
  18. 180  SYM23$="*": SYM28$="#": SYM33$="+": BLNK$=" "
  19. 190  CL$="1-2-3-4-5-6-7-8-9-0-":PI=3.1416
  20. 200  '
  21. 210  SCREEN 0: COLOR 7,0,0: CLS: LOCATE 3,35: PRINT "BIORHYTHMS": LOCATE 6,1:
  22. 220  PRINT "The theory of biorhythms is that we are influenced by three rhythms, physical,": PRINT
  23. 230  PRINT "emotional, and intellectual, beginning the day we are born.  The first and": PRINT
  24. 240  PRINT "middle days of each cycle are considered critical days.  In the biorhythm chart": PRINT
  25. 250  PRINT "which follows these days cross the dateline.": PRINT
  26. 260  PRINT: PRINT "If you have a printer, a printed copy may be made by printing the screen (shift" : PRINT
  27. 270  PRINT "PrtSc)."
  28. 280  LOCATE 20,1: LINE INPUT;  "Enter name: ";WHOM$
  29. 290  LOCATE 21,1: PRINT STRING$(78," "): LOCATE 21,1: PRINT "What is ";WHOM$;"'s ";"birthdate? MM/DD/YY ";: LINE INPUT A$
  30. 300  ON ERROR GOTO 1370
  31. 310  '
  32. 320  IF INSTR (DIGITS$,MID$(A$,1,1)) = 0 THEN ERROR 0
  33. 330  N% = 1: IF INSTR (DIGITS$,MID$(A$,2,1)) <> 0 THEN N% = 2
  34. 340  M% = VAL(MID$(A$,1,N%))
  35. 350  IF M% < 1 OR M% > 12 THEN ERROR 0
  36. 360  '
  37. 370  S% = N% + 2
  38. 380  IF INSTR (DIGITS$,MID$(A$,S%,1)) = 0 THEN ERROR 0
  39. 390  N% = 1: IF INSTR (DIGITS$,MID$(A$,S%+1,1)) <> 0 THEN N% = 2
  40. 400  D% = VAL(MID$(A$,S%,N%))
  41. 410  IF D% < 1 OR D% > 31 THEN ERROR 0
  42. 420  '
  43. 430  S% = S% + N% + 1
  44. 440  Y% = VAL(MID$(A$,S%)): IF Y% = 0 THEN ERROR 0
  45. 450  IF Y% < 100 THEN Y% = Y% + 1900
  46. 460  IF Y% < 1582 THEN ERROR 0
  47. 470  '
  48. 480  LOCATE 22,1: PRINT STRING$(78," "): LOCATE 22,1: LINE INPUT "Start the biorhythm at: MM/YY "; A$
  49. 490  ON ERROR GOTO 1380
  50. 500  IF INSTR (DIGITS$,MID$(A$,1,1)) = 0 THEN ERROR 0
  51. 510  N% = 1: IF INSTR (DIGITS$,MID$(A$,2,1)) <> 0 THEN N% = 2
  52. 520  M1% = VAL(MID$(A$,1,N%))
  53. 530  IF M1% < 1 OR M1% > 12 THEN ERROR 0
  54. 540  '
  55. 550  S% = N% + 2
  56. 560  FOR I% = S% TO LEN(A$)
  57. 570     IF INSTR (DIGITS$,MID$(A$,I%,1)) = 0 THEN ERROR 0
  58. 580  NEXT
  59. 590  Y1% = VAL(MID$(A$,S%)): IF Y1% = 0 THEN ERROR 0
  60. 600  IF Y1% < 100 THEN Y1% = Y1% + 1900
  61. 610  IF Y1% < 1582 THEN ERROR 0
  62. 620  IF Y1% < Y% THEN ERROR 0
  63. 630  IF (Y1% = Y%) AND (M1% < M%) THEN ERROR 0
  64. 640  ON ERROR GOTO 0
  65. 650  '
  66. 660  DYS%=MON%(M%)-D%+1                 'DAYS FROM BIRTH TO END OF MONTH
  67. 670  YEAR% = Y%: GOSUB 1400
  68. 680  IF M% <= 2 AND YEAR% = 0 THEN DYS%=DYS%+1  'LEAP YEAR
  69. 690  '
  70. 700  FOR I%=(M%+1) TO 12                'REST OF BIRTH YEAR
  71. 710  DYS%=DYS%+MON%(I%)
  72. 720  NEXT I%
  73. 730  '
  74. 740  YEAR% = Y1%-Y% -1                 'YEARS IN BETWEEN
  75. 750  C23% = 20 * YEAR%
  76. 760  C28% = 1 * YEAR%
  77. 770  C33% = 2 * YEAR%
  78. 780  '
  79. 790  FOR I%= (Y%+1) TO (Y1%-1)          'LEAP YEARS IN BETWEEN
  80. 800     YEAR% = I%: GOSUB 1400
  81. 810     IF YEAR% = 0 THEN DYS%=DYS%+1
  82. 820  NEXT I%
  83. 830  '
  84. 840  FOR I%=1 TO (M1%-1)                'MONTHS
  85. 850  DYS%=DYS%+MON%(I%)
  86. 860  NEXT I%
  87. 870  '
  88. 880  YEAR% = Y1%: GOSUB 1400
  89. 890  IF M1% >= 2 AND YEAR% = 0 THEN DYS%=DYS%+1   'LEAP YEAR
  90. 900  '
  91. 910  C23%=(C23% + DYS%)MOD 23                   'CALCULATE DAYS INTO CYCLE
  92. 920  C28%=(C28% + DYS%)MOD 28
  93. 930  C33%=(C33% + DYS%)MOD 33
  94. 940  '
  95. 950  CLS
  96. 960  '
  97. 970  PRINT "Biorhythm of ";LEFT$(WHOM$,25);"  for ";MONTH$(M1%); Y1% ;TAB(55);"Birthdate is ";MONTH$(M%);D%;Y%
  98. 980  LOCATE 25,1: COLOR 0,15: PRINT SYM23$;" PHYSICAL  ";
  99. 990  COLOR 0,12: PRINT SYM28$;" EMOTIONAL  ";
  100. 1000  COLOR 0,9: PRINT SYM33$;" INTELLECTUAL";
  101. 1010  COLOR 7,0: PRINT SPC(10);"More BIORHYTHMS? Y/N ";:COLOR 23,0: PRINT "Y";
  102. 1020  LOCATE 13,9: COLOR 0,7: PRINT CL$;CL$;CL$;"1"
  103. 1030  '
  104. 1040  J%=MON%(M1%)
  105. 1050  YEAR% = Y1%: GOSUB 1400
  106. 1060  IF M1% = 2 AND YEAR% = 0 THEN J%=J%+1
  107. 1070  K%=1
  108. 1080  C% = 9
  109. 1090  P23=SIN(2*PI*CSNG(C23%)/23)
  110. 1100  P28=SIN(2*PI*CSNG(C28%)/28)
  111. 1110  P33=SIN(2*PI*CSNG(C33%)/33)
  112. 1120  PNN=P23: GOSUB 1280
  113. 1130  LOCATE INN%,C%: COLOR 0,15: PRINT SYM23$;
  114. 1140  PNN=P28: GOSUB 1280
  115. 1150  LOCATE INN%,C%: COLOR 0,12: PRINT SYM28$;
  116. 1160  PNN=P33: GOSUB 1280
  117. 1170  LOCATE INN%,C%: COLOR 0,9: PRINT SYM33$;
  118. 1180  K%=K%+1
  119. 1190  C% = C% + 2
  120. 1200  '
  121. 1210  C23%=C23%+1                        'next day
  122. 1220  C28%=C28%+1
  123. 1230  C33%=C33%+1
  124. 1240  IF K% <= J% THEN 1090
  125. 1250  COLOR 7,0
  126. 1260  LOCATE 25,71: A$ = INPUT$(1): IF A$ = CHR$(13) OR A$ = "Y" OR A$ = "y" THEN RUN 10
  127. 1270  IF A$ = "N" OR A$ = "n" THEN CLS: END ELSE BEEP: GOTO 1260
  128. 1280  REM ROUTINE TO COMPUTE ROW NUMBER
  129. 1290  REM
  130. 1300  PSGN= SGN(PNN)
  131. 1310  PTT=PSGN*0.05
  132. 1320  IF PTT = 0 THEN PTT = 0.05
  133. 1330  PQQ=-(PNN+PTT)/0.1
  134. 1340  INN%=FIX(PQQ)+13
  135. 1350  RETURN
  136. 1360  '
  137. 1370  PRINT A$;" is an invalid date, please reenter";STRING$(20," "): BEEP: RESUME 290
  138. 1380  PRINT A$;" is an invalid date, please reenter";STRING$(20," "): BEEP: RESUME 480
  139. 1390  '
  140. 1400  IF YEAR% MOD 4 <> 0 THEN RETURN   'LEAP YEAR CALCULATION
  141. 1410  IF (YEAR% MOD 100 = 0) AND (YEAR% MOD 400 <> 0) THEN RETURN
  142. 1420  YEAR% = 0: RETURN
  143. 1430  '
  144. 1440  ' CLEAR KEYBOARD BUFFER
  145. 1450  '
  146. 1460  DEF SEG=0: POKE 1050,PEEK(1052)
  147. 1470  RETURN
  148. 1480  TD%=TD%+1:IF TD%=180 THEN GOTO 1500
  149. 1490  RETURN
  150. 1500  RUN
  151.